home *** CD-ROM | disk | FTP | other *** search
/ Complete Internet Archive / Complete Internet Archive.iso / VRML / cp2b2x.exe / DATA.Z / rmt < prev    next >
Text File  |  1996-04-23  |  5KB  |  206 lines

  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. # rmt --
  6. # This script implements a simple remote-control mechanism for
  7. # Tk applications.  It allows you to select an application and
  8. # then type commands to that application.
  9. #
  10. # @(#) rmt 1.8 95/09/07 11:13:18
  11.  
  12. wm title . "Tk Remote Controller"
  13. wm iconname . "Tk Remote"
  14. wm minsize . 1 1
  15.  
  16. # The global variable below keeps track of the remote application
  17. # that we're sending to.  If it's an empty string then we execute
  18. # the commands locally.
  19.  
  20. set app "local"
  21.  
  22. # The global variable below keeps track of whether we're in the
  23. # middle of executing a command entered via the text.
  24.  
  25. set executing 0
  26.  
  27. # The global variable below keeps track of the last command executed,
  28. # so it can be re-executed in response to !! commands.
  29.  
  30. set lastCommand ""
  31.  
  32. # Create menu bar.  Arrange to recreate all the information in the
  33. # applications sub-menu whenever it is cascaded to.
  34.  
  35. frame .menu -relief raised -bd 2
  36. pack .menu -side top -fill x
  37. menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  38. menu .menu.file.m
  39. .menu.file.m add cascade -label "Select Application" \
  40.     -menu .menu.file.m.apps -underline 0
  41. .menu.file.m add command -label "Quit" -command "destroy ." -underline 0
  42. menu .menu.file.m.apps  -postcommand fillAppsMenu
  43. pack .menu.file -side left
  44.  
  45. # Create text window and scrollbar.
  46.  
  47. text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
  48. scrollbar .s -command ".t yview"
  49. pack .s -side right -fill both
  50. pack .t -side left
  51.  
  52. # Create a binding to forward commands to the target application,
  53. # plus modify many of the built-in bindings so that only information
  54. # in the current command can be deleted (can still set the cursor
  55. # earlier in the text and select and insert;  just can't delete).
  56.  
  57. bindtags .t {.t Text . all}
  58. bind .t <Return> {
  59.     .t mark set insert {end - 1c}
  60.     .t insert insert \n
  61.     invoke
  62.     break
  63. }
  64. bind .t <Delete> {
  65.     catch {.t tag remove sel sel.first promptEnd}
  66.     if {[.t tag nextrange sel 1.0 end] == ""} {
  67.     if [.t compare insert < promptEnd] {
  68.         break
  69.     }
  70.     }
  71. }
  72. bind .t <BackSpace> {
  73.     catch {.t tag remove sel sel.first promptEnd}
  74.     if {[.t tag nextrange sel 1.0 end] == ""} {
  75.     if [.t compare insert <= promptEnd] {
  76.         break
  77.     }
  78.     }
  79. }
  80. bind .t <Control-d> {
  81.     if [.t compare insert < promptEnd] {
  82.     break
  83.     }
  84. }
  85. bind .t <Control-k> {
  86.     if [.t compare insert < promptEnd] {
  87.     .t mark set insert promptEnd
  88.     }
  89. }
  90. bind .t <Control-t> {
  91.     if [.t compare insert < promptEnd] {
  92.     break
  93.     }
  94. }
  95. bind .t <Meta-d> {
  96.     if [.t compare insert < promptEnd] {
  97.     break
  98.     }
  99. }
  100. bind .t <Meta-BackSpace> {
  101.     if [.t compare insert <= promptEnd] {
  102.     break
  103.     }
  104. }
  105. bind .t <Control-h> {
  106.     if [.t compare insert <= promptEnd] {
  107.     break
  108.     }
  109. }
  110. auto_load tkTextInsert
  111. proc tkTextInsert {w s} {
  112.     if {$s == ""} {
  113.     return
  114.     }
  115.     catch {
  116.     if {[$w compare sel.first <= insert]
  117.         && [$w compare sel.last >= insert]} {
  118.         $w tag remove sel sel.first promptEnd
  119.         $w delete sel.first sel.last
  120.     }
  121.     }
  122.     $w insert insert $s
  123.     $w see insert
  124. }
  125.  
  126. .t tag configure bold -font -*-Courier-Bold-R-Normal-*-120-*-*-*-*-*-*
  127.  
  128. # The procedure below is used to print out a prompt at the
  129. # insertion point (which should be at the beginning of a line
  130. # right now).
  131.  
  132. proc prompt {} {
  133.     global app
  134.     .t insert insert "$app: "
  135.     .t mark set promptEnd {insert}
  136.     .t mark gravity promptEnd left
  137.     .t tag add bold {promptEnd linestart} promptEnd
  138. }
  139.  
  140. # The procedure below executes a command (it takes everything on the
  141. # current line after the prompt and either sends it to the remote
  142. # application or executes it locally, depending on "app".
  143.  
  144. proc invoke {} {
  145.     global app executing lastCommand
  146.     set cmd [.t get promptEnd insert]
  147.     incr executing 1
  148.     if [info complete $cmd] {
  149.     if {$cmd == "!!\n"} {
  150.         set cmd $lastCommand
  151.     } else {
  152.         set lastCommand $cmd
  153.     }
  154.     if {$app == "local"} {
  155.         set result [catch [list uplevel #0 $cmd] msg]
  156.     } else {
  157.         set result [catch [list send $app $cmd] msg]
  158.     }
  159.     if {$result != 0} {
  160.         .t insert insert "Error: $msg\n"
  161.     } else {
  162.         if {$msg != ""} {
  163.         .t insert insert $msg\n
  164.         }
  165.     }
  166.     prompt
  167.     .t mark set promptEnd insert
  168.     }
  169.     incr executing -1
  170.     .t yview -pickplace insert
  171. }
  172.  
  173. # The following procedure is invoked to change the application that
  174. # we're talking to.  It also updates the prompt for the current
  175. # command, unless we're in the middle of executing a command from
  176. # the text item (in which case a new prompt is about to be output
  177. # so there's no need to change the old one).
  178.  
  179. proc newApp appName {
  180.     global app executing
  181.     set app $appName
  182.     if !$executing {
  183.     .t mark gravity promptEnd right
  184.     .t delete "promptEnd linestart" promptEnd
  185.     .t insert promptEnd "$appName: "
  186.     .t tag add bold "promptEnd linestart" promptEnd
  187.     .t mark gravity promptEnd left
  188.     }
  189.     return {}
  190. }
  191.  
  192. # The procedure below will fill in the applications sub-menu with a list
  193. # of all the applications that currently exist.
  194.  
  195. proc fillAppsMenu {} {
  196.     catch {.menu.file.m.apps delete 0 last}
  197.     foreach i [lsort [winfo interps]] {
  198.     .menu.file.m.apps add command -label $i -command [list newApp $i]
  199.     }
  200.     .menu.file.m.apps add command -label local -command {newApp local}
  201. }
  202.  
  203. set app [winfo name .]
  204. prompt
  205. focus .t
  206.